home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PBLIB1 / PROGS / DIRS.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-04  |  5KB  |  193 lines
  1. PROGRAM DIRS;
  2.  
  3. {$M 20000,0,50000}
  4.  
  5. Uses DOS, CRT, PbMISC, PbDATA, PbOBJS, PbOUT0, PbPARMS;
  6.  
  7. {
  8. Description : DIRS - Root level DIRS, summary & size
  9.  
  10. Author      : Howard Richoux
  11. Date        : 12/10/93
  12. Last revised: 12/21/93 hnr 1.02 minor changes
  13.                2/18/94 hnr 1.03 new libraries
  14.                5/4/94  hnr 1.05 DIRS c:\pb gets subdirs
  15. Application : IBM PC and compatibles, done in Turbo Pascal 7.0
  16. Status      : Placed in the Public Domain by HNR Software 1/29/94
  17. Published in: none
  18.  
  19. }
  20.  
  21.  
  22. const debug = 0;
  23.  
  24. var err      : byte;
  25.     dirlist  : STRA_object;
  26.     outp     : STRA_object;
  27.     rootstr  : string;
  28.  
  29. type dir_rec = record
  30.       cnt      : longint;
  31.       bytes    : longint;
  32.       lasttime : longint;
  33.       end;
  34.  
  35. var  dir     : dir_rec;
  36. var  tot     : dir_rec;
  37.  
  38. { SearchRec - for reference
  39.     type searchrec = record
  40.            fill  : array[1..21] of byte;
  41.            attr  : byte;
  42.            time  : longint;
  43.            size  : longint;
  44.            name  : string[12];
  45.            end;
  46. }
  47.  
  48.  
  49.  
  50. {*****************************************************************}
  51.  
  52.  
  53. Procedure Logdir( var sr : SearchRec; p : pathstr);
  54. var s : string;
  55.      begin
  56.      if sr.attr <> directory then exit;
  57.      if debug > 0 then
  58.           OUT('D-->'+ FullFmtSearchRec(sr,p));
  59.      if (sr.name <> '.') and (sr.name <> '..') then
  60.           dirlist.append(p+sr.name);
  61.      end;
  62.  
  63.  
  64. Procedure LogFile( var sr : SearchRec; p : pathstr);
  65. var s : string;
  66.      begin
  67.      inc(dir.cnt);
  68.      inc(tot.cnt);
  69.      dir.bytes := dir.bytes + sr.size;
  70.      tot.bytes := tot.bytes + sr.size;
  71.      if dir.lasttime < sr.time then dir.lasttime := sr.time;
  72.      if tot.lasttime < sr.time then tot.lasttime := sr.time;
  73.      end;
  74.  
  75.  
  76. Function FmtDirRec(filespec : string; d : dir_rec) : string;
  77. var s,s1,fl : string;
  78.      begin
  79.      fl := '(' + longintstr(d.cnt,6) + ')';
  80.      removeblanks(fl);
  81.      s1 := filespec;
  82.      s := ExtractPath(s1); { extract path and discard }
  83.      s := leftstr(s1,8) +
  84.           leftstr(fl,7) +
  85.           rightstr(FmtKstrComma(d.bytes),8) + '  ' +
  86.           leftstr(FmtPDateStr(d.lasttime),8);
  87.      FmtDirRec := s;
  88.      end;
  89.  
  90.  
  91. Procedure PrintIt;
  92. var i,j,k : integer;
  93.     begin
  94.     if outp.count > 110 then OUTSetCompressed;
  95.     j := outp.count;
  96.     if j < 1 then
  97.          begin
  98.          OUT('Directory output Empty');
  99.          exit;
  100.          end;
  101.     if (((j div 2) * 2) <> j) then outp.append(' '); { make even # lines}
  102.     j := outp.count div 2;
  103.     for i := 1 to j do
  104.          begin
  105.          OUT(leftstr(outp.fetchN(i),34)+' | '+
  106.                leftstr(outp.fetchN(i+j),34));
  107.          end;
  108.     OUT(' ');
  109.     OUT(FmtDirREc('TOTAL',tot));
  110.     end;
  111.  
  112.  
  113. Procedure GoDownOnePath(filespec : string);
  114.      begin
  115.      fillchar(dir,sizeof(dir),0);
  116.      if debug > 0 then OUT('-->GoDownOnePath ['+filespec+']');
  117.      SearchEngineAll(filespec+'\','*.*',anyfile,LogFile,Err);
  118.      outp.append(FmtDirREc(filespec,dir));
  119.      end;
  120.  
  121.  
  122. Procedure GoDownEachPath;
  123. var i : integer;
  124.      begin
  125.      if dirlist.count < 1 then exit;
  126.      fillchar(tot,sizeof(tot),0);
  127.      fillchar(dir,sizeof(dir),0);
  128.  
  129.      SearchEngine(rootstr,anyfile,LogFile,err); {root}
  130.      outp.append(FmtDirREc('(ROOT)',dir));
  131.  
  132.      i := 1;
  133.      while (i <= dirlist.count) do
  134.           begin
  135.           if keypressed then exit;
  136.           GoDownOnePath(dirlist.fetchN(i));
  137.           inc(i);
  138.           end;
  139.      end;
  140.  
  141.  
  142. Procedure GetRootDirs;
  143.      begin
  144.      writeln('Now you can use "DIRS \WINDOWS" , "DIRS \PB" , ... also.');
  145.      OUT('root = [ '+rootstr+' ]');
  146.      dirlist.init(200);
  147.      outp.init(200);
  148.      SearchEngine(rootstr,directory,LogDir,err);
  149.      if debug > 0 then dirlist.dump;
  150.      end;
  151.  
  152.  
  153. Procedure Init;
  154. var s : string;
  155.      begin
  156.      AddParm(1,'ROOT','c:\*.*');
  157.      StandardOUTInit;
  158.      rootstr := GetParmStr('ROOT');
  159.  
  160.      if paramcount > 0 then
  161.           begin
  162.           s := UpCaseStr(paramstr(1));
  163.           if (s[1] <> '?') and (s <> 'P') then rootstr := s;
  164.           end;
  165.      if rightstr(rootstr,3) <> '*.*' then
  166.           begin
  167.           rootstr := AddBackSlash(rootstr);
  168.           rootstr := rootstr + '*.*';
  169.           end;
  170.      end;
  171.  
  172.  
  173. Procedure Shutdown;
  174.      begin
  175.      dirlist.done;
  176.      outp.done;
  177.      OUTDone;
  178.      end;
  179.  
  180.  
  181. (*  Main program *)
  182.      BEGIN
  183.      pProgID := 'DIRS 1.05';
  184.      Init;
  185.      GetRootDirs;
  186.      dirlist.sort;
  187.      GoDownEachPath;
  188.      PrintIt;
  189.      Shutdown;
  190.      end.
  191.  
  192.  
  193.